perm filename PASS3.F4[2,LCS] blob
sn#153743 filedate 1975-04-04 generic text, type T, neo UTF8
00100 CPASS3 PASS 3 MAIN PROGRAM
00200 C *** MUSIC V ***
00300 C DATA SPECIFICATION
00400 INTEGER PEAK
00500 DIMENSION T(50),TI(50),ITI(50)
00600 COMMON I(15000),P(100)/PARM/IP(20)/FINOUT/PEAK,NRSOR
00700 CC******* DATA IIIRD/Z5EECE66D/
00800 DATA IIIRD/976545367/
00900 C SET I ARRAY =0 (7/10/69)
01000 DATA I/15000*0/
01100 C**************
01200 C INIALIZATION OF PIECE
01300 C ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU
01400 I(7)=IIIRD
01500 IP9=IP(9)
01600 PEAK=0
01700 NRSOR=0
01800 CC******* NREAD = 3
01900 CC******* NWRITE = 2
02000 NREAD=21
02100 C PDP DSK1=DEV.21
02200 NWRITE=1
02300 C PDP DSK=DEV.1
02400 REWIND NREAD
02500 REWIND NWRITE
02600 TYPE 10001
02700 ACCEPT 10002,FLNM,IDSK
02800 C TYPE 'PASS2' OR FILENAME + ANY POS.NUMB. TO WRITE SMPLS ON DSK.
02900 IF(FLNM.EQ.' '.OR.FLNM.EQ.'PASS2')FLNM='FOR21'
03000 CALL IFILE(21,FLNM)
03100 IF(IDSK.NE.0)GO TO 10003
03200 J='MUSAA'
03300 CALL PUTFILE(J)
03400 C IF IDSK=0, SAMPLES WILL BE WRITTEN ON DSK (MUSAA.DMD)
03500 IDSK=0
03600 GO TO 10002
03700 10003 IDSK=-1
03800 10001 FORMAT(' TYPE FILE NAME'/)
03900 10002 FORMAT(A5,I)
04000 C**** ABOVE FOR PDP IO ********
04100 SCLFT=IP(12)
04200 I(2)=IP(4)
04300 MS1=IP(7)
04400 MS3=MS1+(IP(8)*IP(9))-1
04500 MS2=IP(8)
04600 I(4)=IP(3)
04700 MOUT=IP(10)
04800 C INITIALIZATION OF SECTION
04900 5 T(1)=0.0
05000 DO 220N1=MS1,MS3,MS2
05100 220 I(N1)=-1
05200 DO 221N1=1,IP9
05300 221 TI(N1)=1000000.
05400 C MAIN CARD READING LOOP
05500 204 CALL DATA (NREAD)
05600 IF(P(2)-T(1))200,200,244
05700 200 IOP=P(1)
05800 IF(IOP)201,201,202
05900 201 CALLERROR(1)
06000 GO TO 204
06100 202 IF(IP(1)-IOP)201,203,203
06200 203 GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP
06300 11 IVAR=P(3)
06400 IVARE=IVAR+I(1)-4
06500 DO 297 N1=IVAR,IVARE
06600 IVARP=N1-IVAR+4
06700 297 I(N1)=P(IVARP)
06800 GO TO 204
06900 3 IGEN=P(3)
07000 GO TO (281,282,283,284,285),IGEN
07100 281 CALLGEN1
07200 GO TO 204
07300 282 CALLGEN2
07400 GO TO 204
07500 283 CALLGEN3
07600 GO TO 204
07700 284 CALLGEN4
07800 GO TO 204
07900 285 CALLGEN5
08000 GO TO 204
08100 4 IVAR=P(3)
08200 IVARE=IVAR+I(1)-4
08300 DO 296N1=IVAR,IVARE
08400 IVARP=N1-IVAR+4
08500 296 I(N1+100)=P(IVARP)*SCLFT
08600 GO TO 204
08700 6 CALL FROUT3(IDSK)
08800 STOP
08900 C ENTER NOTE TO BE PLAYED
09000 1 DO 230N1=MS1,MS3,MS2
09100 IF(I(N1)+1)230,231,230
09200 230 CONTINUE
09300 CALLERROR(2)
09400 GO TO 204
09500 231 M1=N1
09600 M2=N1+I(1)-1
09700 M3=M2+1
09800 M4=N1+IP(8)-1
09900 DO 232N1=M1,M2
10000 M5=N1-M1+1
10100 232 I(N1)=P(M5)*SCLFT
10200 I(M1 )=P(3)
10300 DO 233N1=M3,M4
10400 233 I(N1)=0
10500 DO 235N1=1,IP9
10600 IF(TI(N1)-1000000.)235,234,235
10700 234 TI(N1)=P(2)+P(4)
10800 ITI(N1)=M1
10900 GO TO 204
11000 235 CONTINUE
11100 CALLERROR(3)
11200 GO TO 204
11300 C DEFINE INSTRUMENT
11400 2 M1=I(2)
11500 M2=IP(5)+IFIX(P(3))
11600 I(M2)=M1
11700 218 CALL DATA (NREAD)
11800 IF(I(1)-2)210,210,211
11900 210 I(M1)=0
12000 I(2)=M1+1
12100 GO TO 204
12200 211 I(M1)=P(3)
12300 M3=I(1)
12400 I(M1+1)=M1+M3-1
12500 M1=M1+2
12600 DO 217N1=4,M3
12700 M5=P(N1)
12800 IF(M5)212,213,213
12900 212 IF(M5+100)300,301,301
13000 300 I(M1)=-IP(2)+(M5+101)*IP(6)
13100 GO TO 216
13200 301 I(M1)=-IP(13)+(M5+1)*IP(14)
13300 GO TO 216
13400 213 IF(M5- 100 )214,214,215
13500 214 I(M1)=M5
13600 GO TO 216
13700 215 I(M1)=M5+262144
13800 216 M1=M1+1
13900 217 CONTINUE
14000 GO TO 218
14100 C PLAY TO ACTION TIME
14200 244 T(2)=P(2)
14300 250 TMIN=1000000.
14400 IREST=1
14500 DO 241N1=1,IP9
14600 IF(TMIN-TI(N1))241,241,240
14700 240 TMIN=TI(N1)
14800 MNOTE=N1
14900 241 CONTINUE
15000 IF(1000000.-TMIN)251,251,243
15100 243 IF(TMIN-T(2))245,245,246
15200 245 T(3)=TMIN
15300 GO TO 260
15400 246 T(3)=T(2)
15500 GO TO 260
15600 247 IF(T(1)-T(2))249,200,200
15700 249 TI(MNOTE)=1000000.
15800 M2=ITI(MNOTE)
15900 I(M2)=-1
16000 GO TO 250
16100 C SETUP REST
16200 251 T(3)=T(2)
16300 IREST=2
16400 GO TO 260
16500 C PLAY
16600 260 ISAM=(T(3)-T(1))*FLOAT(I(4))+.5
16700 T(1)=T(3)
16800 IF(ISAM)247,247,266
16900 266 IF(ISAM-IP(14))262,262,263
17000 262 I(5)=ISAM
17100 ISAM=0
17200 GO TO 264
17300 263 I(5)=IP(14)
17400 ISAM=ISAM-IP(14)
17500 264 IF(I(8))290,290,291
17600 290 M3=MOUT+I(5)-1
17700 MSAMP=I(5)
17800 GO TO 292
17900 291 M3=MOUT+(2*I(5))-1
18000 MSAMP=2*I(5)
18100 292 DO 267N1=MOUT,M3
18200 267 I(N1)=0
18300 GO TO (268,265),IREST
18400 268 DO 270NS1=MS1,MS3,MS2
18500 IF(I(NS1)+1)271,270,271
18600 C GO THROUGH UNIT GENERATORS IN INSTRUMENT
18700 271 I(3)=NS1
18800 IGEN=IP(5)+I(NS1)
18900 IGEN=I(IGEN)
19000 272 I(6)=IGEN
19100 CC***** IF(I(IGEN)-101)293,294,294
19200 CC***** 293 CALLSAMGEN(I)
19300 C**** ABOVE FOR MACHINE LANG. UNIT GENERATORS *******
19400 CC***** GO TO 295
19500 294 CALLFORSAM
19600 295 IGEN=I(IGEN+1)
19700 IF(I(IGEN))270,270,272
19800 270 CONTINUE
19900 265 CALL SAMOUT(IDSK ,MSAMP)
20000 IF(ISAM)247,247,266
20100 END